home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #11 (Aug 86) / forth / mul.sp (revised) < prev   
Text File  |  1986-06-03  |  2KB  |  89 lines
  1. ( 32 bit floating point routines, 27.4.1986 J. Langowski )
  2.  
  3. CODE     S*      ( 32 bit single precision multiply)
  4.          MOVE.L  (A6)+,D1
  5.          BEQ     @zero
  6.          MOVE.L  (A6)+,D0
  7.          BEQ     @end
  8. ( D0,D1 will be used for lower 16 bits of mantissa.
  9.   D2,D3 for exponent )
  10.          MOVE.L  D0,D2
  11.          MOVE.L  D1,D3
  12.          SWAP.W  D2
  13.          SWAP.W  D3
  14. ( get rid of junk in D4,D5 )
  15.          CLR.W   D4
  16.          CLR.W   D5
  17. ( move most significant 7 mantissa bits to D4,D5
  18.   and set implied highest bit = 1 )
  19.          MOVE.B  D2,D4
  20.          MOVE.B  D3,D5
  21.          BSET    #7,D4
  22.          BSET    #7,D5
  23. ( isolate exponent + sign in D2,D3 )
  24. (        ANDI.W  #$FF80,D2 )
  25.          DC.L    $0242FF80
  26. (        ANDI.W  #$FF80,D3 )
  27.          DC.L    $0243FF80
  28. ( rotate sign into lowest bit D2,D3 )
  29.          ROL.W   #1,D2
  30.          ROL.W   #1,D3
  31. ( subtract exponent offset )
  32.          SUBI.W  #$7F00,D2
  33.          SUBI.W  #$7F00,D3
  34. ( sum exponents, check for over- or underflow )
  35.          ADD.W   D2,D3
  36.          BVS     @ovflchk
  37. ( now do 24*24 bit multiplication of mantissa )
  38.          MOVE.W  D4,D2  ( u-hi -> D2 )
  39.          MULU.W  D1,D2  ( u-hi * v-lo -> D2 )
  40.          MULU.W  D0,D1  ( u-lo * v-lo -> D1 )
  41.          MULU.W  D5,D0  ( u-lo * v-hi -> D0 )
  42.          MULU.W  D4,D5  ( u-hi * v-hi -> D5 )
  43.          ADD.L   D2,D0  ( u-hi*v-lo + u-lo*v-hi -> D0 )
  44.          MOVE.W  D5,D1  ( u-hi*v-hi -> LSW[D1], MSW unchanged )
  45.          SWAP.W  D1
  46.          ADD.L   D1,D0  ( put it all together )
  47. ( highest mantissa bit might have changed to one )
  48.          BPL     @nohibit
  49.          ADDI.W  #$100,D3
  50.          BVC     @round
  51.          BRA     @ovflchk
  52. @nohibit ADD.L   D0,D0
  53. @round   BTST    #7,D0
  54.          BEQ     @blk.exp
  55.          BTST    #6,D0
  56.          BNE     @incr
  57.          BTST    #8,D0
  58.          BEQ     @blk.exp
  59. @incr    ADDI.L  #$80,D0
  60.          BCC     @blk.exp
  61.          ADDI.W  #$100,D3
  62.          BVC     @blk.exp
  63. @ovflchk BPL     @makezero
  64.          MOVE.L  #$7F800000,-(A6)  
  65.          RTS
  66. @makezero  CLR.L D0
  67.          MOVE.L  D0,-(A6)
  68.          RTS
  69. @zero    CLR.L D0
  70.          MOVE.L  D0,(A6)
  71.          RTS
  72. ( readjust exponent )
  73. @blk.exp ADDI.W  #$7F00,D3
  74.          BLE     @makezero
  75.          ROR.W   #1,D3
  76.  
  77. (        ANDI.W  #$FF80,D3 )
  78.          DC.L    $0243FF80
  79.  
  80.          LSR.L   #8,D0
  81.          BCLR    #23,D0
  82.          SWAP.W  D3
  83.          CLR.W   D3
  84.          OR.L    D3,D0
  85. @end     MOVE.L  D0,-(A6)
  86.          RTS     
  87. END-CODE          
  88.  
  89.